home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)G / (A)G1.ADF / ABasic_games / bg < prev    next >
Text File  |  1988-09-29  |  22KB  |  757 lines
  1.   WINDOW CLOSE 1
  2.   SCREEN 1,320,200,3,1
  3.   WINDOW 2,"",(0,0)-(311,185),16,1
  4.  
  5.   DEFINT a-z
  6.   human=1:amiga=-1:volume=255
  7.   DIM rgb(WINDOW(6),2,1)
  8.   DIM board(25),tempbrd(25),menonboard(1),options(1,35)
  9.   DIM amymove(4),amyroll(4),dice(1),thisroll(4),movesto(4)
  10.   DIM d1(122),d2(122),d3(122),d4(122),d5(122),d6(122)
  11.  
  12.   temp&=PEEKL(PEEKL(PEEKL(WINDOW(7)+46)+48)+4)
  13.   FOR i=0 TO 7
  14.     msg$=RIGHT$("00"+HEX$(PEEKW(temp&+2*i)),3)
  15.     FOR j=1 TO 3:rgb(i,j-1,0)=VAL("&h"+MID$(msg$,j,1)):NEXT
  16.   NEXT
  17.   FOR i=0 TO 3
  18.     READ r,g,b
  19.     PALETTE i,r/16,g/16,b/16
  20.     PALETTE i+4,r/28,g/28,b/28
  21.   NEXT
  22.   DATA  0, 0, 0,   7, 4, 3,  15,12,10,   13,13,13
  23.   temp&=PEEKL(PEEKL(PEEKL(WINDOW(7)+46)+48)+4)
  24.   FOR i=0 TO 7
  25.     msg$=RIGHT$("00"+HEX$(PEEKW(temp&+2*i)),3)
  26.     FOR j=1 TO 3:rgb(i,j-1,1)=VAL("&h"+MID$(msg$,j,1)):NEXT
  27.   NEXT
  28.  
  29.   MENU 1,0,1,"System"
  30.     MENU 1,1,1,"Restart"
  31.     MENU 1,2,1,"About  "
  32.     MENU 1,3,1,"WBench "
  33.     MENU 1,4,1,"Colors "
  34.     MENU 1,5,1,"Volume "
  35.     MENU 1,6,1,"List   "
  36.     MENU 1,7,1,"Quit   "
  37.   FOR temp=2 TO 4:MENU temp,0,0,"":NEXT
  38.   ON MENU GOSUB menudown
  39.  
  40.   READ msg$
  41.   WHILE msg$<>"Done"
  42.     IF VAL(msg$)>0 THEN
  43.       COLOR VAL(msg$)
  44.     ELSE
  45.       PRINT SPC((39-LEN(msg$))/2);msg$
  46.     END IF
  47.     READ msg$
  48.   WEND
  49.   DATA 3,"","<<<-<<<- AMIGA BACKGAMMON ->>>->>>",""
  50.   DATA 2,"AmigaBasic Version by john everett"
  51.   DATA "ABasic Version by David Addison"
  52.   DATA "Original ST Version by TCB",""
  53.   DATA 7,"You will play the light pieces and"
  54.   DATA "move clockwise from the upper left"
  55.   DATA 6,"","To move a piece, click on piece"
  56.   DATA "to be moved and then click on the"
  57.   DATA "destination point"
  58.   DATA 1,"","To bear off use the bar on the"
  59.   DATA "left as the destination"
  60.   DATA 6,"","If you do not have a valid move"
  61.   DATA "click on the dice"
  62.   DATA 7,"","Enjoy!",""
  63.   DATA 2,"Loading data...","Done"
  64.  
  65.   FOR i=0 TO 35:READ options(0,i),options(1,i):NEXT
  66.   DATA 8,6,6,13,6,8,6,13,6,13,8,13
  67.   DATA 13,6,13,6,13,13,6,8,13,13,0,0
  68.   DATA 8,6,13,13,13,8,13,13,8,13,13,13
  69.   DATA 13,6,8,6,13,13,13,9,13,13,13,13
  70.   DATA 13,6,13,13,13,8,13,13,13,8,13,13
  71.   DATA 13,8,13,7,13,13,13,13,13,13,24,13
  72.  
  73.   OPEN "dice" FOR INPUT AS #1
  74.     FOR i=0 TO 122:INPUT #1,d1(i):NEXT
  75.     FOR i=0 TO 122:INPUT #1,d2(i):NEXT
  76.     FOR i=0 TO 122:INPUT #1,d3(i):NEXT
  77.     FOR i=0 TO 122:INPUT #1,d4(i):NEXT
  78.     FOR i=0 TO 122:INPUT #1,d5(i):NEXT
  79.     FOR i=0 TO 122:INPUT #1,d6(i):NEXT
  80.   CLOSE #1
  81.  
  82.   LOCATE 23,10:PRINT "Click MOUSE to start"
  83.   CALL whoa
  84. '--------------------------------------------------------------------
  85. restart:
  86.   RESTORE restart
  87.   FOR i=0 TO 12:READ board(i):board(25-i)=-board(i):NEXT
  88.     DATA  0,2,0,0,0,0,-5,0,-3,0,0,0,5
  89.   menonboard(0)=15:menonboard(1)=15
  90.   thinkahead=0:firstmove=0:restart=0
  91.  
  92.   WINDOW OUTPUT 2:COLOR 1,0:CLS
  93.   FOR place=1 TO 24:GOSUB triangle:NEXT
  94.   LINE (0,0)-(12,194),6,bf
  95.     LINE (2,2)-(10,192),0,bf
  96.     LINE (4,4)-(8,190),7,bf
  97.   LINE (146,0)-(165,194),1,bf
  98.   LINE (146,79)-(165,115),0,bf
  99.   LINE (146,80)-(165,114),6,bf
  100.     LINE (148,82)-(163,112),0,bf
  101.     LINE (150,84)-(161,110),7,bf
  102.       LINE (152,86)-(153,108),2,bf
  103.         LINE (154,86)-(159,88),2,bf
  104.         LINE (154,96)-(157,98),2,bf
  105.         LINE (154,106)-(159,108),2,bf
  106.   LINE (299,0)-(311,194),6,bf
  107.     LINE (301,2)-(309,192),0,bf
  108.     LINE (303,4)-(307,190),7,bf
  109.  
  110.   FOR place=1 TO 24
  111.     FOR man=1 TO ABS(board(place))
  112.       GOSUB drawpiece
  113.     NEXT
  114.   NEXT
  115.  
  116.   RANDOMIZE TIMER
  117.   dice(0)=dice(1):numbrmoves=2
  118.   WHILE dice(0)=dice(1):FOR i=0 TO 1:dice(i)=INT(6*RND+1):NEXT:WEND
  119.   IF dice(0)>dice(1) THEN turn=human ELSE turn=amiga
  120.   WINDOW CLOSE 3
  121.   GOTO showdice
  122. '--------------------------------------------------------------------
  123. rolldice:
  124.   IF dice(0)>0 THEN whichdie=0:GOSUB erasedice
  125.   IF dice(1)>0 THEN whichdie=1:GOSUB erasedice
  126.   turn=-turn:throw=0
  127. dloop:
  128.   SOUND 500,.3,volume,0:SOUND 550,.3,volume,1
  129.   RANDOMIZE TIMER
  130.   dice(0)=INT(6*RND+1):dice(1)=INT(6*RND+1)
  131.   IF dice(0)=dice(1) THEN numbrmoves=4 ELSE numbrmoves=2
  132. showdice:
  133.   dicepos=54-153*(turn=amiga)
  134.   FOR temp=0 TO 1
  135.     dicepos=32*temp+dicepos
  136.     IF dice(temp)=1 THEN
  137.       PUT (dicepos,87),d1,PSET
  138.     ELSEIF dice(temp)=2 THEN
  139.       PUT (dicepos,87),d2,PSET
  140.     ELSEIF dice(temp)=3 THEN
  141.       PUT (dicepos,87),d3,PSET
  142.     ELSEIF dice(temp)=4 THEN
  143.       PUT (dicepos,87),d4,PSET
  144.     ELSEIF dice(temp)=5 THEN
  145.       PUT (dicepos,87),d5,PSET
  146.     ELSEIF dice(temp)=6 THEN
  147.       PUT (dicepos,87),d6,PSET
  148.     END IF
  149.   NEXT
  150.   throw=throw+1:IF throw<12 THEN dloop
  151.   IF turn=amiga THEN
  152.     MENU ON
  153.     delay&=TIMER+1:WHILE TIMER<delay&:WEND
  154.     IF thinkahead>0 THEN amyready
  155.     IF firstmove=0 THEN
  156.       firstmove=1
  157.       IF dice(0)=2 AND dice(1)=6 THEN dice(0)=6:dice(1)=2:firstmove=2
  158.       amymove(2)=options(0,6*dice(0)+dice(1)-7)
  159.       amymove(1)=options(1,6*dice(0)+dice(1)-7)
  160.       amyroll(2)=dice(0)
  161.       amyroll(1)=dice(1)
  162.       IF firstmove=2 THEN dice(0)=2:dice(1)=6
  163.       IF numbrmoves=4 THEN
  164.         amymove(3)=amymove(1)
  165.         amyroll(3)=amyroll(1)
  166.         amymove(4)=amymove(2)
  167.         amyroll(4)=amyroll(2)
  168.       END IF
  169.       IF board(amymove(1)-amyroll(1))>1 THEN tryme
  170.       IF board(amymove(2)-amyroll(2))>1 THEN tryme
  171.       thinkahead=numbrmoves
  172.       GOTO amyready
  173.     END IF
  174.     GOTO amigaturn
  175.   END IF
  176.   MENU OFF
  177. '--------------------------------------------------------------------
  178. humanfrom:
  179.   GOSUB checkmouse
  180.   IF movepieceto=26 THEN canhumanpass
  181.   IF (board(25)>0 AND movepieceto<>25) OR movepieceto=0 OR board(movepieceto)<1 THEN humanfrom
  182.   upfrom=movepieceto
  183.   GOSUB pickuppiece
  184. humanto:
  185.   GOSUB checkmouse
  186.   IF movepieceto=upfrom THEN
  187.     place=movepieceto
  188.     man=board(movepieceto)
  189.     GOSUB drawpiece
  190.     GOTO humanfrom
  191.   END IF
  192.   IF movepieceto>24 THEN humanto    '           *** *** cant quit or on dice
  193.   IF movepieceto=0 THEN movepieceto=25
  194.   IF board(movepieceto)<-1 THEN humanto '       *** *** if amigapiece there
  195.   IF upfrom=25 THEN goingto=movepieceto ELSE goingto=movepieceto-upfrom
  196.   IF goingto<1 OR goingto>6 THEN humanto
  197.   whichdie=-1
  198.   IF goingto=dice(0) THEN whichdie=0:GOTO chekmove
  199.   IF goingto=dice(1) THEN whichdie=1:GOTO chekmove
  200.   IF movepieceto=25 AND dice(0)>goingto THEN goingto=dice(0):whichdie=0
  201.   IF movepieceto=25 AND dice(1)>goingto THEN goingto=dice(1):whichdie=1
  202.   IF whichdie=-1 THEN humanto
  203. chekmove:
  204.   IF upfrom=25 OR upfrom+goingto<25 THEN domove
  205.   FOR i=1 TO 18
  206.     IF board(i)>0 THEN humanto
  207.   NEXT
  208.   IF upfrom+goingto=25 THEN domove
  209.   FOR i=19 TO upfrom-1
  210.     IF board(i)>0 THEN humanto
  211.   NEXT
  212. '--------------------------------------------------------------------
  213. domove:
  214.   IF restart THEN concede
  215.   IF goingto=dice(0) THEN whichdie=0 ELSE whichdie=1
  216.   IF numbrmoves<3 THEN GOSUB erasedice
  217.   numbrmoves=numbrmoves-1
  218.  
  219.   place=upfrom
  220.   man=ABS(board(place))
  221.   GOSUB fixboard
  222.  
  223.   goingto=goingto*turn
  224.   board(upfrom)=board(upfrom)-turn
  225.   IF upfrom=0 OR upfrom=25 THEN upfrom=25-upfrom
  226.   IF upfrom+goingto<1 OR upfrom+goingto>24 THEN offboard
  227.   IF board(upfrom+goingto)=-turn THEN
  228.     place=upfrom+goingto    '   *** *** bump someone *** ***
  229.     man=1
  230.     GOSUB fixboard
  231.     place=-25*(turn=amiga)
  232.     board(place)=board(place)-turn
  233.     board(upfrom+goingto)=0
  234.     man=ABS(board(place))
  235.     GOSUB drawpiece
  236.     SOUND 500,1,volume,0:SOUND 1000,1,volume,1
  237.   END IF
  238.   place=upfrom+goingto
  239.   board(place)=board(place)+turn
  240.   man=ABS(board(place))
  241.   GOSUB drawpiece
  242.   SOUND 500,1,volume,0:SOUND 1000,1,volume,1
  243.   GOTO endmove
  244. offboard:
  245.   menonboard((turn+1)/2)=menonboard((turn+1)/2)-1
  246.   i=6*(14-menonboard((turn+1)/2))+3
  247.   IF turn=amiga THEN
  248.     LINE (3,i)-STEP(6,6),piececolor+5,bf
  249.     LINE (4,i+1)-STEP(4,4),piececolor,bf
  250.   ELSE
  251.     LINE (3,194-i)-STEP(6,-6),piececolor+5,bf
  252.     LINE (4,194-i-1)-STEP(4,-4),piececolor,bf
  253.   END IF
  254.   SOUND 1200,2,volume,0:SOUND 1800,2,volume,1
  255.   IF menonboard(0)=0 OR menonboard(1)=0 THEN winner
  256. endmove:
  257.   IF numbrmoves=0 THEN rolldice
  258.   GOTO showdice
  259. '--------------------------------------------------------------------
  260. amigaturn:
  261.   b1&=-99999&
  262.   ss=0
  263.   ht=0
  264.   b5=0
  265.   thisroll(1)=dice(0)
  266.   thisroll(2)=dice(1)
  267.   thisroll(3)=dice(0)
  268.   thisroll(4)=dice(0)
  269.   FOR i=1 TO 4
  270.     movesto(i)=24
  271.   NEXT
  272.   nmoves2=numbrmoves
  273.   j=-board(0)
  274.   IF j>numbrmoves THEN j=numbrmoves
  275.   IF j>0 THEN FOR i=1 TO j:movesto(i)=26:NEXT
  276. tryme:
  277.   FOR i=0 TO 25:tempbrd(i)=board(i):NEXT
  278.   movesto2=0
  279.   movesto=menonboard(0)
  280.  
  281.   FOR whichmove=1 TO nmoves2
  282.     IF movesto(whichmove)>25 THEN
  283.       IF tempbrd(25-thisroll(whichmove))>1 THEN z720
  284.       IF tempbrd(25-thisroll(whichmove))=1 THEN
  285.         tempbrd(25)=tempbrd(25)+1
  286.         tempbrd(25-thisroll(whichmove))=0
  287.       END IF
  288.       tempbrd(25-thisroll(whichmove))=tempbrd(25-thisroll(whichmove))-1
  289.       tempbrd(0)=tempbrd(0)+1
  290.       GOTO endtryme
  291.     END IF
  292. findmove:
  293.     IF whichmove>1 THEN
  294.       IF movesto(whichmove)+ss>movesto(whichmove-1) THEN z120
  295.     END IF
  296.     IF tempbrd(movesto(whichmove))<0 THEN z140
  297. z120:
  298.     movesto(whichmove)=movesto(whichmove)-1
  299.     IF movesto(whichmove)>0 THEN findmove
  300.     GOTO z670
  301. z140:
  302.     IF movesto(whichmove)-thisroll(whichmove)<1 THEN z180
  303.     IF tempbrd(movesto(whichmove)-thisroll(whichmove))>1 THEN z120
  304.     IF tempbrd(movesto(whichmove)-thisroll(whichmove))=1 THEN
  305.       tempbrd(25)=tempbrd(25)+1
  306.       tempbrd(movesto(whichmove)-thisroll(whichmove))=0
  307.     END IF
  308.     tempbrd(movesto(whichmove)-thisroll(whichmove))=tempbrd(movesto(whichmove)-thisroll(whichmove))-1
  309.     tempbrd(movesto(whichmove))=tempbrd(movesto(whichmove))+1
  310.     GOTO endtryme
  311. z180:
  312.     FOR j=7 TO 24
  313.       IF tempbrd(j)<0 THEN z670
  314.     NEXT
  315.     IF movesto(whichmove)-thisroll(whichmove)=0 THEN z220
  316.     jm=movesto(whichmove)+1
  317.     FOR j=jm TO 6
  318.       IF tempbrd(j)<0 THEN z670
  319.     NEXT
  320. z220:
  321.     tempbrd(movesto(whichmove))=tempbrd(movesto(whichmove))+1
  322.     movesto=movesto-1
  323. endtryme:
  324.     movesto2=movesto2+thisroll(whichmove)
  325.   NEXT
  326.  
  327.   IF movesto2<ht THEN z720
  328.   ht=movesto2:mi=0:bt=0
  329.   FOR i=1 TO 24
  330.     IF tempbrd(i)>0 THEN
  331.       IF i<19 THEN mi=mi+tempbrd(i)*INT((22-i)/4)/2
  332.     END IF
  333.     IF tempbrd(i)<0 THEN
  334.       IF i>6 THEN mi=mi+tempbrd(i)*INT((i-3)/4)/2
  335.     END IF
  336.   NEXT
  337.   mi=mi+3*(tempbrd(0)+tempbrd(25))
  338.   IF tempbrd(25)>1 THEN mi=mi+1
  339.   ct=0
  340.   IF tempbrd(25)-tempbrd(0) THEN ct=1:GOTO z340 '*** *** IF x-y* THEN what???
  341.  
  342.   FOR i=24 TO 2 STEP -1
  343.     IF tempbrd(i)<0 THEN z320
  344.   NEXT
  345.   GOTO z340
  346. z320:
  347.   FOR j=i-1 TO 1 STEP -1
  348.     IF tempbrd(j)>0 THEN ct=1:GOTO z340
  349.   NEXT
  350.  
  351. z340:
  352.   bl=0
  353.   IF ct=0 THEN bt=0:GOTO z420
  354.   hp=0
  355.   FOR i=1 TO 24
  356.     IF tempbrd(i)=-1 THEN
  357.       bt=bt-INT((30-i)/4)/2
  358.       IF i<7 THEN mi=mi-1
  359.     END IF
  360.     IF i>18 AND board(i)>1 THEN hp=hp+1
  361.   NEXT
  362.   hp=hp*hp+(hp=0)
  363.   bt=INT(bt*hp/25+.5)/2
  364.   FOR i=1 TO 4
  365.     b=0
  366.     FOR j=i TO i+5
  367.       b=b-(tempbrd(j)<-1)
  368.     NEXT
  369.     b=INT(b*b/4)
  370.     bl=bl-(b>bl)*(b-bl)
  371.   NEXT
  372. z420:
  373.   IF mi+bl+bt<b1&+b2+b3 THEN z630
  374.   tc=0:bo=0:ds=0:lo=1
  375.   FOR i=1 TO 24
  376.     IF i>6 THEN IF tempbrd(i)<0 THEN tc=tc+tempbrd(i)*INT((i-1)/6):bo=bo+i*tempbrd(i)
  377.     IF tempbrd(i)<0 THEN ds=ds+1:lo=lo*(0-tempbrd(i))
  378.   NEXT i
  379.   IF b1&=-99999& THEN z600
  380.   IF bl+mi+bt>b2+b1&+b3 THEN z600
  381.   IF movesto<b9 THEN z600
  382.   IF movesto>b9 THEN z630
  383.   IF tc<b4 THEN z630
  384.   IF tc>b4 THEN z600
  385.   IF ds<b6 THEN z630
  386.   IF ds>b6 THEN z600
  387.   IF bo<b7 THEN z630
  388.   IF bo>b7 THEN z600
  389.   IF lo<b8 THEN z630
  390.   IF lo>b8 THEN z600
  391.   GOTO z630
  392. z600:
  393.   b5=nmoves2:b2=bl:b3=bt:b4=tc:b1&=mi:b9=movesto
  394.   b6=ds:bt=bo:b8=lo:j=1-(b5<numbrmoves)
  395.   FOR i=1 TO b5
  396.     amymove(j+i-1)=movesto(b5+1-i)
  397.     amyroll(j+i-1)=thisroll(b5+1-i)
  398.   NEXT
  399. z630:
  400.   IF movesto(nmoves2)=26 THEN z720
  401.   movesto(nmoves2)=movesto(nmoves2)-1
  402.   IF movesto(nmoves2)>0 THEN tryme
  403.   whichmove=nmoves2
  404.  
  405. z670:
  406.   FOR j=whichmove TO nmoves2:movesto(j)=24:NEXT
  407.   whichmove=whichmove-1
  408.   IF whichmove=0 THEN z720
  409.   IF movesto(whichmove)=26 THEN z720
  410.   IF movesto(whichmove)>1 THEN movesto(whichmove)=movesto(whichmove)-1:GOTO tryme
  411.   GOTO z670
  412.  
  413. z720:
  414.   IF dice(1)<>dice(0) THEN
  415.     IF ss=1 THEN
  416.       ss=0
  417.       thisroll(1)=dice(0)
  418.       thisroll(2)=dice(1)
  419.     ELSE
  420.       ss=1
  421.       thisroll(1)=dice(1)
  422.       thisroll(2)=dice(0)
  423.       GOTO tryme
  424.     END IF
  425.   END IF
  426. z760:
  427.   nmoves2=nmoves2-1
  428.   IF nmoves2<>0 AND ht=0 THEN tryme
  429.   IF b5<numbrmoves THEN
  430.     amymove(1)=27
  431.     thinkahead=b5+1
  432.   ELSE
  433.     thinkahead=numbrmoves
  434.   END IF
  435. amyready:
  436.   movepieceto=amymove(thinkahead)
  437.   goingto=amyroll(thinkahead)
  438.   thinkahead=thinkahead-1
  439.   IF movepieceto=26 THEN movepieceto=0
  440.   IF movepieceto=27 THEN rolldice
  441.   upfrom=movepieceto
  442.   GOSUB pickuppiece
  443.   GOTO domove
  444. '--------------------------------------------------------------------
  445. canhumanpass:
  446.   IF board(25)<>0 THEN
  447.     FOR i=0 TO 1
  448.       IF dice(i)>0 AND board(dice(i))>-2 THEN msg$="Must move onto board":GOTO passwindow
  449.     NEXT
  450.   ELSE
  451.     FOR i=0 TO 1
  452.       IF dice(i)>0 THEN
  453.         FOR j=1 TO 24-dice(i)
  454.           IF board(j)>0 AND board(j+dice(i))>-2 THEN msg$="You have a move":GOTO passwindow
  455.         NEXT
  456.       END IF
  457.     NEXT
  458.     FOR j=1 TO 18
  459.       IF board(j)>0 THEN rolldice
  460.     NEXT
  461.     FOR i=0 TO 1
  462.       IF dice(i)>0 AND board(25-dice(i))>0 THEN msg$="You can move off":GOTO passwindow
  463.     NEXT
  464.     FOR i=19 TO 24
  465.       IF board(i)>0 THEN
  466.         FOR j=0 TO 1
  467.           IF dice(j)>0 AND dice(j)>25-i THEN msg$="Get off the board, dummy":GOTO passwindow
  468.         NEXT
  469.       END IF
  470.     NEXT
  471.   END IF
  472.   GOTO rolldice
  473. passwindow:
  474.   WINDOW 3,"Click to continue...",(20,80)-(290,88),0,1
  475.   BEEP:PRINT msg$;:whoa
  476.   WINDOW CLOSE 3
  477.   GOTO humanfrom
  478. '--------------------------------------------------------------------
  479. winner:
  480.   FOR whichdie=0 TO 1
  481.     IF dice(whichdie)>0 THEN GOSUB erasedice
  482.   NEXT
  483.   IF menonboard(0)=0 THEN msg$="the AMIGA wins" ELSE msg$="the HUMAN wins"
  484.   IF menonboard(0)<15 AND menonboard(1)<15 THEN endofgame
  485.   FOR i=0 TO 6
  486.     IF board(i)>0 OR board(25-i)<0 THEN
  487.       msg$=msg$+" with a BACKGAMMON"
  488.       GOTO endofgame
  489.     END IF
  490.   NEXT
  491.   msg$=msg$+" with a GAMMON"
  492. endofgame:
  493.   WINDOW 3,"       It's all over and...",(20,80)-(290,88),0,1
  494.   COLOR 3:LOCATE 1,(34-LEN(msg$))/2:PRINT msg$;
  495.   FOR temp=1 TO 100
  496.     FOR i=0 TO 2:SWAP rgb(1,i,1),rgb(2,i,1):NEXT
  497.     FOR i=1 TO 2:PALETTE i,rgb(i,0,1)/16,rgb(i,1,1)/16,rgb(i,2,1)/16:NEXT
  498.     SOUND 10*temp+200,.5,volume,0:SOUND 12.5*temp+250,.5,volume,3
  499.     FOR i=0 TO 2:SWAP rgb(1,i,1),rgb(2,i,1):NEXT
  500.     FOR i=1 TO 2:PALETTE i,rgb(i,0,1)/16,rgb(i,1,1)/16,rgb(i,2,1)/16:NEXT
  501.     SOUND 15*temp+300,.5,volume,1:SOUND 20*temp+400,.5,volume,2
  502.   NEXT
  503.   GOTO restart
  504. concede:
  505.   msg$="the HUMAN has given up!":GOTO endofgame
  506. '--------------------------------------------------------------------
  507. checkmouse:
  508.   IF restart THEN concede
  509.   WHILE MOUSE(0)=0 AND menu0=0
  510.     menu0=MENU(0)
  511.     SLEEP
  512.   WEND:WHILE MOUSE(0)<>0:WEND
  513.   IF menu0>0 THEN GOSUB menudown:GOTO checkmouse
  514.   mousex=MOUSE(3):mousey=MOUSE(4)
  515.   IF mousex<14 THEN movepieceto=0:RETURN
  516.   IF mousex>146 AND mousex<165 THEN
  517.     IF mousey>116 THEN movepieceto=25:RETURN
  518.     IF mousey>77 THEN
  519.       WINDOW 3,"Do that again...",(30,30)-(174,38),0,1
  520.       COLOR 2,7:CLS:PRINT " it feels GOOD!!!";
  521.       delay&=TIMER+1:WHILE TIMER<delay&:WEND
  522.       WINDOW CLOSE 3
  523.     END IF
  524.     GOTO checkmouse
  525.   ELSEIF mousex<147 THEN
  526.     IF mousey>85 AND mousey<109 THEN movepieceto=26:RETURN
  527.   ELSEIF mousex>164 THEN
  528.     IF mousey>85 AND mousey<109 THEN checkmouse
  529.     mousex=mousex-21
  530.   END IF
  531.   mousex=mousex-25
  532.   whichpoint=mousex/22
  533.   IF mousey>96 THEN
  534.     movepieceto=24-whichpoint
  535.   ELSE
  536.     movepieceto=whichpoint+1
  537.   END IF
  538.   RETURN
  539. '--------------------------------------------------------------------
  540. putwhere:
  541.   IF place<13 THEN x=place-1 ELSE x=24-place
  542.   placex=22*x+24
  543.   IF x>5 THEN placex=placex+21
  544.   IF place=0 OR place=25 THEN placex=155
  545.   placey=17*(man-1)+8
  546.   IF place>12 THEN placey=194-placey
  547.   IF man>5 THEN placey=14*(place>12)+8-176*(place>12)
  548.   IF board(place)<0 THEN piececolor=1 ELSE piececolor=2
  549.   RETURN
  550.  
  551. drawpiece:
  552.   GOSUB putwhere
  553.   IF man<6 THEN
  554.     CIRCLE(placex,placey),10,piececolor+5
  555.     PAINT(placex,placey),piececolor,piececolor+5
  556.   ELSE
  557.     COLOR piececolor+5,piececolor:LOCATE -22*(place>12)+2
  558.     PRINT PTAB(placex-3);:PRINT USING "#";man-4;
  559.   END IF
  560.   RETURN
  561.  
  562. fixboard:
  563.   GOSUB putwhere
  564.   LINE (placex-10,placey-8)-STEP(20,16),0,bf
  565.   IF place=0 OR place=25 THEN
  566.     LINE (146,placey-8)-(165,placey+8),1,bf
  567.   ELSE
  568.     GOSUB triangle
  569.   END IF
  570.   IF man>1 THEN
  571.     FOR man=1 TO man-1
  572.       GOSUB drawpiece
  573.     NEXT
  574.   END IF
  575.   RETURN
  576. '--------------------------------------------------------------------
  577. triangle:
  578.   IF place<13 THEN x=place-1 ELSE x=24-place
  579.   trix=22*x+14:IF x>5 THEN trix=trix+21
  580.   COLOR -(place AND 1)+2
  581.   IF place<13 THEN
  582.     AREA (trix,0):AREA STEP(10,80)
  583.     AREA STEP(0,-1):AREA STEP(10,-79):AREAFILL
  584.   ELSE
  585.     AREA (trix,194):AREA STEP(10,-80)
  586.     AREA STEP(0,1):AREA STEP(10,79):AREAFILL
  587.   END IF
  588.   RETURN
  589.  
  590. '--------------------------------------------------------------------
  591. pickuppiece:
  592.   place=movepieceto
  593.   man=ABS(board(place))
  594.   GOSUB putwhere
  595.   CIRCLE(placex,placey),10,7
  596.   PAINT(placex,placey),3,7
  597.   SOUND 1000,.1,volume,0:SOUND 2000,.1,volume,1
  598.   IF turn=human THEN temp=5 ELSE temp=1
  599.   WHILE temp<5
  600.     SOUND 1000,.1,volume,0
  601.     PAINT(placex,placey),piececolor,7
  602.     PAINT(placex,placey),3,7
  603.     temp=temp+1
  604.   WEND
  605.   RETURN
  606.  
  607. erasedice:
  608.   dicepos=54-153*(turn=amiga)
  609.   dicepos=32*whichdie+dicepos
  610.   LINE (dicepos,87)-STEP(20,19),0,bf
  611.   dice(whichdie)=0
  612.   RETURN
  613. '--------------------------------------------------------------------
  614. menudown:
  615.   menu0=MENU(0):menu0=0
  616.   ON MENU(1) GOTO giveup,about,wbench,fixcolors,fixvolume,show,quit
  617. giveup:
  618.   restart=-1:RETURN
  619. about:
  620.   WINDOW 3,"about...",(58,24)-(249,104),0,1
  621.   COLOR 7,2:CLS
  622.   PRINT "This is the first of the"
  623.   PRINT "  David Addison games"
  624.   PRINT "   which I intend to "
  625.   PRINT " rewrite in AmigaBASIC."
  626.   PRINT "      More to come!":PRINT:COLOR 1
  627.   PRINT "      john everett"
  628.   PRINT "  PeopleLINK ID OHS303":PRINT:COLOR 7
  629.   PRINT "    ... Click Me ...";:whoa
  630.   WINDOW CLOSE 3:WINDOW 2
  631.   RETURN
  632. wbench:
  633.   WINDOW 3,"BackGammon",(400,0)-(480,8),18,-1
  634.   COLOR 3,2:CLS:PRINT " Click Me";:whoa
  635.   WINDOW CLOSE 3:WINDOW 2
  636.   RETURN
  637. fixcolors:
  638.   CALL docolors
  639.   RETURN
  640. fixvolume:
  641.   WINDOW 3,"Volume:",(30,80)-(287,88),0,1
  642.   LINE (0,0)-(volume-1,8),7,bf
  643.   LINE (volume,0)-(volume+1,8),3,bf
  644.   LINE (volume+2,0)-(257,8),0,bf
  645.   SOUND  300,30,volume,0:SOUND  400,30,volume,1
  646.   WHILE MOUSE(0)=0:SLEEP:WEND
  647.   WHILE MOUSE(0)<0
  648.     volume=MOUSE(1):IF volume>255 THEN volume=255
  649.     SOUND  300,.6,volume,0:SOUND  400,.6,volume,1
  650.     LINE (0,0)-(volume-1,8),7,bf
  651.     LINE (volume,0)-(volume+1,8),3,bf
  652.     LINE (volume+2,0)-(257,8),0,bf
  653.   WEND
  654.   WINDOW CLOSE 3
  655.   RETURN
  656. show:
  657.   listflag=-1
  658. quit:
  659.   MENU RESET
  660.   IF NOT debug THEN
  661.     FOR freq=1200 TO 100 STEP -10
  662.       SOUND freq,.3,volume,0:SOUND 1.25*freq,.3,volume,1
  663.     NEXT
  664.     WINDOW 9,,(236,89)-(236+160,89+7),0
  665.     COLOR 3,2:CLS:PRINT "    john everett":PRINT "PeopleLINK ID OHS303";
  666.     SOUND  200,50,volume,0:SOUND  250,50,volume,1
  667.     SOUND  300,50,volume,2:SOUND  400,50,volume,3
  668.   END IF
  669.   WINDOW CLOSE 2:SCREEN CLOSE 1
  670.   IF NOT debug THEN
  671.     delay&=TIMER+3:WHILE TIMER<delay&:WEND
  672.     WINDOW CLOSE 9
  673.   END IF
  674.   REM $ignore on
  675.   IF listflag THEN LIST
  676.   REM $ignore off
  677.   SOUND 1600,1,volume,0:SOUND 2000,1,volume,1
  678.   SOUND  100,2,volume,0:SOUND  125,2,volume,1
  679.   IF listflag THEN END
  680.   SYSTEM
  681. '--------------------------------------------------------------------
  682. SUB whoa STATIC
  683.   WHILE MOUSE(0)<>0:WEND:WHILE MOUSE(0)=0:SLEEP:WEND:WHILE MOUSE(0)<>0:WEND
  684. END SUB
  685.  
  686. SUB msgbox (x,y,pen,paper,msg$) STATIC
  687.   IF x<0 THEN
  688.     x=(WINDOW(2)/8-LEN(msg$))/2
  689.     length=WINDOW(2)/8-2*x+4
  690.   ELSE
  691.     length=LEN(msg$)+4
  692.   END IF
  693.   IF y>-1 AND msg$<>"" THEN
  694.     LINE (8*x-15,8*ABS(y)-12)-(8*x+8*length-2,8*ABS(y)+2),pen,bf
  695.     LINE (8*x-13,8*ABS(y)-11)-(8*x+8*length-4,8*ABS(y)+1),paper,bf
  696.     LINE (8*x-11,8*ABS(y)-10)-(8*x+8*length-6,8*ABS(y)),pen,bf
  697.     LINE (8*x-9,8*ABS(y)-9)-(8*x+8*length-8,8*ABS(y)-1),paper,bf
  698.   END IF
  699.   COLOR pen,paper:LOCATE ABS(y),x+2:PRINT msg$;
  700. END SUB
  701.  
  702. SUB docolors STATIC
  703.   SHARED rgb()
  704.   WINDOW 8,"       Palette       ",(60,30)-(226,144),18,1
  705.   FOR i=0 TO WINDOW(6)/4-1
  706.     FOR j=0 TO 3
  707.       LINE (24*(j+3)  ,10*i  )-STEP(23,9),4*i+j,bf
  708.       LINE (24*(j+3)+2,10*i+1)-STEP(19,7),0,bf
  709.       LINE (24*(j+3)+4,10*i+2)-STEP(15,5),4*i+j,bf
  710.       IF 4*i+j>WINDOW(6) THEN j=3
  711.     NEXT
  712.   NEXT
  713.   msgbox  2,14,1,0,"RESET"
  714.   msgbox 13,14,1,0,"OKAY"
  715. colorloop:
  716.   temp&=PEEKL(PEEKL(PEEKL(WINDOW(7)+46)+48)+4)
  717.   msg$=RIGHT$("00"+HEX$(PEEKW(temp&+2*colr)),3)
  718.   LOCATE 12,1
  719.   FOR i=0 TO 2
  720.     c(i)=VAL("&h"+MID$(msg$,i+1,1))
  721.     LINE (24*i+2,0)-(24*i+20,74-5*c(i)),0,bf
  722.     LINE (24*i+2,75-5*c(i))-(24*i+20,80),1,bf
  723.     PRINT " "MID$(msg$,i+1,1)" ";
  724.   NEXT
  725.   PRINT "  color="colr;
  726.   i=MOUSE(0):i=0:WHILE i=0:i=MOUSE(0):SLEEP:WEND
  727.   IF MOUSE(3)>166 OR MOUSE(4)>114 THEN colorloop
  728.   IF MOUSE(3)>72 THEN
  729.     i=(MOUSE(3)-82)/24:j=(MOUSE(4)-5)/10
  730.     IF 4*j+i<=WINDOW(6) THEN colr=4*j+i
  731.   END IF
  732.   IF MOUSE(3)<71 AND MOUSE(4)<80 THEN
  733.     WHILE MOUSE(0)<>0
  734.       j=15-MOUSE(2)/5:i=(MOUSE(3)-10)/24
  735.       IF j=>0 AND j<16 THEN c(i)=j
  736.       PALETTE colr,c(0)/16,c(1)/16,c(2)/16
  737.       LINE (24*i+2,0)-(24*i+20,74-5*c(i)),0,bf
  738.       LINE (24*i+2,75-5*c(i))-(24*i+20,80),colr,bf
  739.       LOCATE 12,3*i+2:PRINT MID$("0123456789ABCDEF",c(i)+1,1);
  740.     WEND
  741.   END IF
  742.   IF MOUSE(4)<102 THEN colorloop
  743.   IF MOUSE(3)<88 THEN
  744.     FOR i=0 TO WINDOW(6)
  745.       PALETTE i,rgb(i,0,0)/16,rgb(i,1,0)/16,rgb(i,2,0)/16
  746.     NEXT
  747.     SOUND 800,1,volume,0:SOUND 1000,1,volume,1
  748.     GOTO colorloop
  749.   END IF
  750.   temp&=PEEKL(PEEKL(PEEKL(WINDOW(7)+46)+48)+4)
  751.   FOR i=0 TO 7
  752.     msg$=RIGHT$("00"+HEX$(PEEKW(temp&+2*i)),3)
  753.     FOR j=1 TO 3:rgb(i,j-1,1)=VAL("&h"+MID$(msg$,j,1)):NEXT
  754.   NEXT
  755.   WINDOW CLOSE 8
  756. END SUB
  757.